home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mac Magazin/MacEasy 11
/
Mac Magazin and MacEasy Magazine CD - Issue 11.iso
/
Sharewarebibliothek
/
Entwickler
/
WASTE 1.1b1 Distribution
/
WASTE Source
/
WEObjects.p
< prev
next >
Wrap
Text File
|
1995-06-01
|
17KB
|
615 lines
unit WEObjects;
{ WASTE PROJECT: }
{ Embedded Objects }
{ Copyright © 1993-1995 Marco Piovanelli }
{ All Rights Reserved }
interface
uses
WEDebug;
const
{ values for WEInstallObjectHandler handlerSelector parameter }
weNewHandler = 'new ';
weDisposeHandler = 'free';
weDrawHandler = 'draw';
weClickHandler = 'clik';
weCursorHandler = 'curs';
type
{ A WESoup record is a static description of an object embedded in the text. }
{ The 'SOUP' data type is just a collection of WESoup records, each followed }
{ by the corresponding object data. }
{ This data type complements the standard TEXT/styl pair. }
WESoup = record
soupOffset: LongInt; { insertion offset for this object }
soupType: OSType; { 4-letter tag identifying object type }
soupReserved1: LongInt; { reserved for future use; set to zero }
soupDataSize: Size; { size of object data following this record }
soupSize: Point; { object height and width, in pixels }
soupReserved2: LongInt; { reserved for future use; set to zero }
{ actual object data follows }
end; { WESoup }
WESoupPtr = ^WESoup;
WESoupHandle = ^WESoupPtr;
{ A WEObjectDesc record is used to keep track of embedded objects in memory. }
{ Notice that the first two fields are an AEDesc record, i.e. "tagged data" }
WEObjectDesc = record
objectType: OSType; { 4-letter tag identifying object type }
objectDataHandle: Handle; { handle to object data }
objectSize: Point; { object height and width, in pixels }
objectTable: Handle; { handle to object handler table }
objectIndex: Integer; { precalculated index into object handler table }
objectOwner: WEHandle; { handle to owner WE instance }
objectRefCon: LongInt; { free for use by object handlers }
end; { WEObjectDesc }
WEObjectDescPtr = ^WEObjectDesc;
WEObjectDescHandle = ^WEObjectDescPtr;
WEObjectReference = WEObjectDescHandle;
type
{ callback prototypes and UPPs }
{ FUNCTION MyNewObject (VAR defaultObjectSize: Point; objectRef: WEObjectReference): OSErr; }
WENewObjectProcPtr = ProcPtr;
WENewObjectUPP = UniversalProcPtr;
{ FUNCTION MyDisposeObject (objectRef: WEObjectReference): OSErr; }
WEDisposeObjectProcPtr = ProcPtr;
WEDisposeObjectUPP = UniversalProcPtr;
{ FUNCTION MyDrawObject (destRect: Rect; objectRef : WEObjectReference): OSErr; }
WEDrawObjectProcPtr = ProcPtr;
WEDrawObjectUPP = UniversalProcPtr;
{ FUNCTION MyClickObject (hitPt: Point; modifiers: Integer; }
{ clickTime: LongInt; objectRef: WEObjectReference): Boolean; }
WEClickObjectProcPtr = ProcPtr;
WEClickObjectUPP = UniversalProcPtr;
const
{ UPP proc info }
uppWENewObjectProcInfo = $000003E0;
uppWEDisposeObjectProcInfo = $000000E0;
uppWEDrawObjectProcInfo = $000003E0;
uppWEClickObjectProcInfo = $00003ED0;
{ New "macros" }
function NewWENewObjectProc (userRoutine: WENewObjectProcPtr): WENewObjectUPP;
{$IFC NOT GENERATINGCFM}
inline
$2E9F;
{$ENDC}
function NewWEDisposeObjectProc (userRoutine: WEDisposeObjectProcPtr): WEDisposeObjectUPP;
{$IFC NOT GENERATINGCFM}
inline
$2E9F;
{$ENDC}
function NewWEDrawObjectProc (userRoutine: WEDrawObjectProcPtr): WEDrawObjectUPP;
{$IFC NOT GENERATINGCFM}
inline
$2E9F;
{$ENDC}
function NewWEClickObjectProc (userRoutine: WEClickObjectProcPtr): WEClickObjectUPP;
{$IFC NOT GENERATINGCFM}
inline
$2E9F;
{$ENDC}
{ Call "macros" }
function CallWENewObjectProc (var defaultObjectSize: Point;
objectRef: WEObjectReference;
userRoutine: WENewObjectUPP): OSErr;
{$IFC NOT GENERATINGCFM}
inline
$205F, $4E90;
{$ENDC}
function CallWEDisposeObjectProc (objectRef: WEObjectReference;
userRoutine: WEDisposeObjectUPP): OSErr;
{$IFC NOT GENERATINGCFM}
inline
$205F, $4E90;
{$ENDC}
function CallWEDrawObjectProc (destRect: Rect;
objectRef: WEObjectReference;
userRoutine: WEDrawObjectUPP): OSErr;
{$IFC NOT GENERATINGCFM}
inline
$205F, $4E90;
{$ENDC}
function CallWEClickObjectProc (hitPoint: Point;
modifiers: Integer;
clickTime: LongInt;
objectRef: WEObjectReference;
userRoutine: WEClickObjectUPP): Boolean;
{$IFC NOT GENERATINGCFM}
inline
$205F, $4E90;
{$ENDC}
{ embedded object functions for use by the client application }
function WEInstallObjectHandler (objectType: OSType;
handlerSelector: OSType;
handler: UniversalProcPtr;
hWE: WEHandle): OSErr;
{ accessor functions for use by object handlers }
function WEGetObjectType (hObjectDesc: WEObjectDescHandle): OSType;
function WEGetObjectDataHandle (hObjectDesc: WEObjectDescHandle): Handle;
function WEGetObjectSize (hObjectDesc: WEObjectDescHandle): Point;
function WEGetObjectOwner (hObjectDesc: WEObjectDescHandle): WEHandle;
function WEGetObjectRefCon (hObjectDesc: WEObjectDescHandle): LongInt;
procedure WESetObjectRefCon (hObjectDesc: WEObjectDescHandle;
refCon: LongInt);
{ object management function for WASTE internal use }
function _WENewObject (objectType: OSType;
objectDataHandle: Handle;
hWE: WEHandle;
var hObjectDesc: WEObjectDescHandle): OSErr;
function _WEFreeObject (hObjectDesc: WEObjectDescHandle): OSErr;
function _WEDrawObject (hObjectDesc: WEObjectDescHandle): OSErr;
function _WEClickObject (hitPt: Point;
modifiers: Integer;
clickTime: LongInt;
hObjectDesc: WEObjectDescHandle): Boolean;
function _WEGetIndObjectType (index: Integer;
var objectType: OSType;
hWE: WEHandle): OSErr;
implementation
uses
ToolUtils;
const
kUnknownObjectType = -1; { specifies an object type for which no handlers are installed }
kDefaultObjectSize = $00200020; { default object size (32x32 pixels) }
type
WEOHTableElement = record
objectType: OSType; { 4-letter tag identifying object type }
newHandler: WENewObjectUPP;
freeHandler: WEDisposeObjectUPP;
drawHandler: WEDrawObjectUPP;
clickHandler: WEClickObjectUPP;
cursorHandler: UniversalProcPtr;
end; { WEOHTableElement }
WEOHTableElementPtr = ^WEOHTableElement;
WEOHTable = array[0..0] of WEOHTableElement;
WEOHTablePtr = ^WEOHTable;
WEOHTableHandle = ^WEOHTablePtr;
var
{ static variables }
_weGlobalObjectHandlerTable: Handle;
function WEGetObjectType (hObjectDesc: WEObjectDescHandle): OSType;
begin
WEGetObjectType := hObjectDesc^^.objectType;
end; { WEGetObjectType }
function WEGetObjectDataHandle (hObjectDesc: WEObjectDescHandle): Handle;
begin
WEGetObjectDataHandle := hObjectDesc^^.objectDataHandle;
end; { WEGetObjectDataHandle }
function WEGetObjectSize (hObjectDesc: WEObjectDescHandle): Point;
begin
WEGetObjectSize := hObjectDesc^^.objectSize;
end; { WEGetObjectSize }
function WEGetObjectOwner (hObjectDesc: WEObjectDescHandle): WEHandle;
begin
WEGetObjectOwner := hObjectDesc^^.objectOwner;
end; { WEGetObjectOwner }
function WEGetObjectRefCon (hObjectDesc: WEObjectDescHandle): LongInt;
begin
WEGetObjectRefCon := hObjectDesc^^.objectRefCon;
end; { WEGetObjectRefCon }
procedure WESetObjectRefCon (hObjectDesc: WEObjectDescHandle;
refCon: LongInt);
begin
hObjectDesc^^.objectRefCon := refCon;
end; { WESetObjectRefCon }
function _WELookupObjectType (objectType: OSType;
hTable: Handle): Integer;
{ look for a WEOHTableElement record for the specified object kind }
{ in the given object handler table }
var
nEntries, index: Integer;
begin
{ assume no handlers have been installed for this object type }
_WELookupObjectType := kUnknownObjectType;
{ do nothing if the Object Handler Table has not been inited yet }
if (hTable = nil) then
Exit(_WELookupObjectType);
{ calculate entry count }
nEntries := Integer(GetHandleSize(hTable)) div SizeOf(WEOHTableElement);
{ scan the Object Handler Table looking for a type match }
for index := nEntries - 1 downto 0 do
if (WEOHTableHandle(hTable)^^[index].objectType = objectType) then
begin
_WELookupObjectType := index;
Exit(_WELookupObjectType);
end;
end; { _WELookupObjectType }
function _WEGetIndObjectType (index: Integer;
var objectType: OSType;
hWE: WEHandle): OSErr;
label
0, 1;
var
hTable: Handle;
nEntries: Integer;
err: OSErr;
begin
err := weUnknownObjectTypeErr; { assume failure }
objectType := OSType(0);
{ index must be non-negative }
if (index < 0) then
goto 1;
{ calculate number of entries in the instance-specific handler table }
nEntries := 0;
hTable := hWE^^.hObjectHandlerTable;
if (hTable <> nil) then
nEntries := Integer(GetHandleSize(hTable)) div SizeOf(WEOHTableElement);
{ low indices refer to the instance-specific handler table }
if (index < nEntries) then
begin
objectType := WEOHTableHandle(hTable)^^[index].objectType;
goto 0;
end;
{ indices above that refer to the global handler table }
index := index - nEntries;
{ calculate number of entries in the global handler table }
nEntries := 0;
hTable := _weGlobalObjectHandlerTable;
if (hTable <> nil) then
nEntries := Integer(GetHandleSize(hTable)) div SizeOf(WEOHTableElement);
{ return an error code if index is too large }
if (index >= nEntries) then
goto 1;
objectType := WEOHTableHandle(hTable)^^[index].objectType;
0:
{ clear result code }
err := noErr;
1:
{ return result code }
_WEGetIndObjectType := err;
end; { _WEGetIndObjectType }
function _WENewObject (objectType: OSType;
objectDataHandle: Handle;
hWE: WEHandle;
var hObjectDesc: WEObjectDescHandle): OSErr;
label
1;
var
hTable: Handle;
pDesc: WEObjectDescPtr;
index: Integer;
err: OSErr;
begin
_WENewObject := noErr;
hObjectDesc := nil;
{ first look up the specified object type in the instance-specific handler table }
hTable := hWE^^.hObjectHandlerTable;
index := _WELookupObjectType(objectType, hTable);
if (index = kUnknownObjectType) then
begin
{ no match: try with the global handler table }
hTable := _weGlobalObjectHandlerTable;
index := _WELookupObjectType(objectType, hTable);
if (index = kUnknownObjectType) then
hTable := nil;
end;
{ create a new relocatable block to hold the object descriptor }
err := _WEAllocate(SizeOf(WEObjectDesc), kAllocClear, hObjectDesc);
if (err <> noErr) then
goto 1;
{ lock it down }
HLock(Handle(hObjectDesc));
pDesc := hObjectDesc^;
{ fill in the object descriptor }
pDesc^.objectType := objectType;
pDesc^.objectDataHandle := objectDataHandle;
pDesc^.objectSize := Point(kDefaultObjectSize);
pDesc^.objectTable := hTable;
pDesc^.objectIndex := index;
pDesc^.objectOwner := hWE;
if (hTable <> nil) then
with WEOHTableHandle(hTable)^^[index] do
{ call the new handler, if any }
if (newHandler <> nil) then
begin
err := CallWENewObjectProc(pDesc^.objectSize, hObjectDesc, newHandler);
if (err <> noErr) then
begin
_WEForgetHandle(hObjectDesc);
goto 1;
end;
end;
{ unlock the object descriptor }
HUnlock(Handle(hObjectDesc));
{ clear result code }
err := noErr;
1:
{ return result code }
_WENewObject := err;
end; { _WENewObject }
function _WEFreeObject (hObjectDesc: WEObjectDescHandle): OSErr;
var
pDesc: WEObjectDescPtr;
begin
_WEFreeObject := noErr;
{ sanity check: do nothing if we have a null descriptor handle }
if (hObjectDesc = nil) then
begin
_WEFreeObject := nilHandleErr;
Exit(_WEFreeObject);
end;
{ lock the descriptor record }
HLock(Handle(hObjectDesc));
pDesc := hObjectDesc^;
if (pDesc^.objectTable <> nil) then
with WEOHTableHandle(pDesc^.objectTable)^^[pDesc^.objectIndex] do
begin
{$IFC WASTE_DEBUG}
{ sanity check: make sure object kind matches handler kind }
_WEAssert(pDesc^.objectType = objectType, 'Object Type Mismatch');
{$ENDC}
{ call the dispose handler, if any }
if (freeHandler <> nil) then
begin
_WEFreeObject := CallWEDisposeObjectProc(hObjectDesc, freeHandler);
pDesc^.objectDataHandle := nil;
end;
end;
{ if object kind is unknown or there's no custom dispose handler, use DisposeHandle }
_WEForgetHandle(pDesc^.objectDataHandle);
{ finally, dispose of the object descriptor itself }
DisposeHandle(Handle(hObjectDesc));
end; { _WEFreeObject }
function _WEDrawObject (hObjectDesc: WEObjectDescHandle): OSErr;
var
pDesc: WEObjectDescPtr;
destRect: Rect;
state: PenState;
saveDescLock: Boolean;
begin
_WEDrawObject := noErr;
{ lock the object descriptor }
saveDescLock := _WESetHandleLock(hObjectDesc, true);
pDesc := hObjectDesc^;
{ get current pen state }
{ state.pnLoc has already been set to the bottom left of the rectangle to draw }
GetPenState(state);
{ calculate the new pen position }
state.pnLoc.h := state.pnLoc.h + pDesc^.objectSize.h;
{ calculate the object destination rectangle }
destRect.topLeft := Point(DeltaPoint(state.pnLoc, pDesc^.objectSize));
destRect.botRight := state.pnLoc;
if (pDesc^.objectTable <> nil) then
with WEOHTableHandle(pDesc^.objectTable)^^[pDesc^.objectIndex] do
begin
{$IFC WASTE_DEBUG}
{ sanity check: make sure object kind matches handler kind }
_WEAssert(pDesc^.objectType = objectType, 'Object Type Mismatch');
{$ENDC}
{ call the drawing handler, if any }
if (drawHandler <> nil) then
_WEDrawObject := CallWEDrawObjectProc(destRect, hObjectDesc, drawHandler);
end
else
begin
{ if this object kind was not registered, draw an empty frame }
PenNormal;
FrameRect(destRect);
end;
{ restore original pen state, advancing the pen position by the object width }
SetPenState(state);
{ unlock the object descriptor }
if (_WESetHandleLock(hObjectDesc, saveDescLock)) then
;
end; { _WEDrawObject }
function _WEClickObject (hitPt: Point;
modifiers: Integer;
clickTime: LongInt;
hObjectDesc: WEObjectDescHandle): Boolean;
var
pDesc: WEObjectDescPtr;
saveDescLock: Boolean;
begin
_WEClickObject := false; { assume we won't intercept this click }
{ lock the object descriptor }
saveDescLock := _WESetHandleLock(hObjectDesc, true);
pDesc := hObjectDesc^;
if (pDesc^.objectTable <> nil) then
with WEOHTableHandle(pDesc^.objectTable)^^[pDesc^.objectIndex] do
begin
{$IFC WASTE_DEBUG}
{ sanity check: make sure object kind matches handler kind }
_WEAssert(pDesc^.objectType = objectType, 'Object Type Mismatch');
{$ENDC}
{ call the click handler, if any }
if (clickHandler <> nil) then
_WEClickObject := CallWEClickObjectProc(hitPt, modifiers, clickTime, hObjectDesc, clickHandler);
end;
{ unlock the object descriptor }
if (_WESetHandleLock(hObjectDesc, saveDescLock)) then
;
end; { _WEClickObject }
function WEInstallObjectHandler (objectType: OSType;
handlerSelector: OSType;
handler: UniversalProcPtr;
hWE: WEHandle): OSErr;
label
1;
var
hTable: Handle;
index: Integer;
element: WEOHTableElement;
err: OSErr;
begin
{ if hWE is NIL, install the handler in the global handler table, }
{ otherwise install the handler in the instance-specific handler table }
if (hWE = nil) then
hTable := _weGlobalObjectHandlerTable
else
hTable := hWE^^.hObjectHandlerTable;
{ create the handler table, if it doesn't exist }
if (hTable = nil) then
begin
hTable := NewHandle(0);
err := MemError;
if (err <> noErr) then
goto 1;
if (hWE = nil) then
_weGlobalObjectHandlerTable := hTable
else
hWE^^.hObjectHandlerTable := hTable;
end;
{ look for the entry corresponding to the specified object type }
index := _WELookupObjectType(objectType, hTable);
if (index = kUnknownObjectType) then
begin
{ previously unknown object type: append a new entry at the end of the handler table }
index := Integer(GetHandleSize(hTable)) div SizeOf(WEOHTableElement);
_WEBlockClr(@element, SizeOf(element));
element.objectType := objectType;
err := _WEInsertSlot(hTable, @element, index, SizeOf(element));
if (err <> noErr) then
goto 1;
end;
{ install the handler }
with WEOHTableHandle(hTable)^^[index] do
err := _WESetField(_WEObjectHandlerSelectorTable, handlerSelector, @handler, @objectType);
1:
{ return result code }
WEInstallObjectHandler := err;
end; { WEInstallObjectHandler }
{$IFC GENERATINGCFM}
function NewWENewObjectProc (userRoutine: WENewObjectProcPtr): WENewObjectUPP;
begin
NewWENewObjectProc := NewRoutineDescriptor(userRoutine, uppWENewObjectProcInfo, GetCurrentArchitecture);
end; { NewWENewObjectProc }
function NewWEDisposeObjectProc (userRoutine: WEDisposeObjectProcPtr): WEDisposeObjectUPP;
begin
NewWEDisposeObjectProc := NewRoutineDescriptor(userRoutine, uppWEDisposeObjectProcInfo, GetCurrentArchitecture);
end; { NewWEDisposeObjectProc }
function NewWEDrawObjectProc (userRoutine: WEDrawObjectProcPtr): WEDrawObjectUPP;
begin
NewWEDrawObjectProc := NewRoutineDescriptor(userRoutine, uppWEDrawObjectProcInfo, GetCurrentArchitecture);
end; { NewWEDrawObjectProc }
function NewWEClickObjectProc (userRoutine: WEClickObjectProcPtr): WEClickObjectUPP;
begin
NewWEClickObjectProc := NewRoutineDescriptor(userRoutine, uppWEClickObjectProcInfo, GetCurrentArchitecture);
end; { NewWEClickObjectProc }
{$ENDC}
end.